home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pull70.zip / PULLSHEL.ZIP / PULLSTAT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-21  |  12KB  |  343 lines
  1. { ========================================================================== }
  2. { PullStat.pas - User Statistics for pull-down menus.      ver 7.0, 06-21-93 }
  3. {                                                                            }
  4. { This file contains all the data for GetUserPullStats, GetOverrideStats and }
  5. { CheckGlobalKeys to configure the menus.                                    }
  6. {   Copyright (c) 1988,1993 James H. LeMay, All rights reserved.             }
  7. { ========================================================================== }
  8.  
  9. {$i pulldefs.inc }
  10.  
  11. UNIT PullStat;
  12.  
  13. INTERFACE
  14.  
  15. { ------------------ Set up your window names here in order: --------------- }
  16. { This is optional, but it sure helps you in not only understanding the
  17.   program, but also makes it unquestionably easier to rearrange.             }
  18.  
  19. type
  20.   MainMenuNames = (NoMainMenu,FirstMenu,QuitMenu);
  21.   SubMenuNames  = (NoSubMenu,MySubMenu);
  22.   { These names are reserved up to HelpML and must match those in PULL.PAS. }
  23.   MsgLineNames = (NoML,WorkML,TopML,AltML,MainML,SubML,DW_ML,DE_ML,
  24.                   SeqML,HelpML,ProcML);
  25.   HelpWndwNames = (NoHW,WorkWndwHW,TopLineHW,MainMenuHW,SubMenuHW,DataWndwHW);
  26.   HelpLineNames = (
  27.     NoHL,      { HL - HelpLine;  L - Last }
  28.     HLw1,HLwL, { Work window }
  29.     HLt1,HLtL, { Top Line menu }
  30.     HLm1,HLmL, { Main menu }
  31.     HLs1,HLsL, { Submenu }
  32.     HLd1,HLd2,HLd3,HLd4,HLd5,HLd6,HLdL); { Data window }
  33.   DataWndwNames = (NoDW,aByteDW);
  34.  
  35. { Careful! - Always test your last main menu, submenu, data window, and help
  36.   window for run-time error!  It makes sure you have allotted enough memory
  37.   with your constants.  The compiler cannot check it with these typed
  38.   scalars. }
  39.  
  40. procedure GetUserPullStats;
  41. procedure GetOverrideStats;
  42. procedure CheckGlobalKeys;
  43.  
  44.  
  45. IMPLEMENTATION
  46.  
  47. uses
  48.   Crt,Qwik,Wutil,Wndw,Pull;
  49.  
  50. { -- Trivial utilities to get and save a menu record fro the heap -- }
  51. procedure GetMainMenu (Name: MainMenuNames);
  52. begin
  53.   MRI := ord (Name);
  54.   TopMenu := MainMenu^[MRI];
  55. end;
  56.  
  57. procedure SaveMainMenu;
  58. begin
  59.   MainMenu^[MRI] := TopMenu;
  60. end;
  61.  
  62. {$ifdef UseSubMenuCode }
  63. procedure GetSubMenu (Name: SubMenuNames);
  64. begin
  65.   MRI := ord (Name);
  66.   TopMenu := SubMenu^ [MRI];
  67. end;
  68.  
  69. procedure SaveSubMenu;
  70. begin
  71.   SubMenu^[MRI] := TopMenu;
  72. end;
  73. {$endif }
  74.  
  75. {$ifdef UseHelpWndwCode }
  76. procedure SetHelpLines (Name: HelpWndwNames; First,Last: HelpLineNames);
  77. begin
  78.   HelpWndw[ord(Name)].FirstLine := ord(First);
  79.   HelpWndw[ord(Name)].LastLine  := ord(Last);
  80. end;
  81. {$endif }
  82.  
  83. { ============================ EXEC PROCEDURES ============================= }
  84. { Place procedures for execution by menu pointers, ProcPtr, here.            }
  85. { They MUST be set to FAR calls.                                             }
  86. { -------------------------------------------------------------------------- }
  87.  
  88. procedure DummyProc; far;
  89. begin
  90.   {$ifdef UseMsgLineCode }
  91.   ShowMsg (ord(ProcML));
  92.   {$endif UseMsgLineCode }
  93.   Delay (1000)
  94. end;
  95.  
  96. procedure SetQuit; far;
  97. begin
  98.   PopToWorkWndw := true;
  99.   Quit := true;
  100. end;
  101.  
  102. { ======================== GetUserPullStats ================================ }
  103. { The major configurations for all menus go here.  The program first clears  }
  104. { all RECORD values to $00.  The values below will set new values. Therefore,}
  105. { setting RECORD values to "false" or the like is not necessary.             }
  106. { -------------------------------------------------------------------------- }
  107.  
  108. procedure GetUserPullStats;
  109. begin
  110.   DefaultLinkDir := Right; { This is the preferrable location for submenus
  111.                              located relative to the main menu.  Use Right
  112.                              or Left for slide-up or Down for slide under. }
  113.   LocationWarning := true; { If true and a Submenu won't fit, a message is
  114.                              displayed. If false, you can override the
  115.                              location without the message. }
  116.  
  117.   { ------------------ Set up your colors and borders here: ---------------- }
  118.   TopLineAttr   := Black+LightGrayBG;
  119.   TopLineHattr  := White+BlackBG;
  120.  
  121.   MainMenuBattr := Black+LightGrayBG;
  122.   MainMenuHattr := LightGray+BlackBG;
  123.   MainMenuLattr := White+LightGrayBG;
  124.   MainMenuWattr := Black+LightGrayBG;
  125.   MainMenuCattr := Black+LightGrayBG;
  126.   Brdr[UserBrdr1].BrdrArray := '╒═╕││└─┘╞═╡╤│┴╪';
  127.   MainMenuBrdr  := UserBrdr1;
  128.  
  129.   {$ifdef UseSubMenuCode }
  130.   SubMenuWattr  := Black+CyanBG;
  131.   SubMenuBattr  := Black+CyanBG;
  132.   SubMenuBrdr   := SingleBrdr;
  133.   {$endif UseSubMenuCode }
  134.  
  135.   if VideoMode=7 then
  136.     begin
  137.       TopLineLattr := TopLineAttr;
  138.       {$ifdef UseSubMenuCode }
  139.       SubMenuHattr := Black    +LightGrayBG;
  140.       SubMenuLattr := White    +BlackBG;
  141.       SubMenuCattr := LightGray+BlackBG;
  142.       {$endif UseSubMenuCode }
  143.     end
  144.   else
  145.     begin
  146.       TopLineLattr := Red  +LightGrayBG;
  147.       {$ifdef UseSubMenuCode }
  148.       SubMenuHattr := White+BlueBG;
  149.       SubMenuLattr := White+CyanBG;
  150.       SubMenuCattr := Blue +CyanBG;
  151.       {$endif UseSubMenuCode }
  152.     end;
  153.  
  154.   {$ifdef UseHelpWndwCode }
  155.   HelpWndwWattr := Black+GreenBG;
  156.   HelpWndwBattr := Black+LightGrayBG;
  157.   HelpWndwBrdr  := HdoubleBrdr;
  158.   HelpWndwModes := ZoomMode+ShadowRight+CursorOffMode;
  159.   HelpBottomRow := CRTrows-4;
  160.   {$endif UseHelpWndwCode }
  161.  
  162.   {$ifdef UseMsgLineCode }
  163.   MsgLineAttr   := Black+GreenBG;
  164.   MsgLineHattr  := White+GreenBG;
  165.   if QvideoMode=Mono then
  166.        KeyStatusAttr := LightGrayBG
  167.   else KeyStatusAttr := Blue+LightGrayBG;
  168.   ErrMsgAttr    := Yellow+RedBG;
  169.   MsgLineRow    := CRTrows;
  170.   {$endif UseMsgLineCode }
  171.  
  172.  
  173.   { ------------------------- Top Menu defaults ---------------------------- }
  174.   TopLineRow := 2;      { Top line menu to appear on row 2 }
  175.   MPulled    := ord(FirstMenu);  { Main menu title to be HiLited by F10. }
  176.   MoreCmdSeq := 'F';    { Sequence of command letter(s) as if keyed in. }
  177.                         { This will be the default menu(s) pulled. }
  178.   PullDown   := false;  { Set this true if you want the command sequence}
  179.                         {  to pull down the menus at startup. }
  180.  
  181.   { ------------------- Set up your MainMenu records here: ------------------}
  182.   MainMenuRow := 3;     { First row of Main menus to appear on screen row 3  }
  183.  
  184.   with TopMenu do
  185.   begin
  186.  
  187.     GetMainMenu (FirstMenu);
  188.     MenuMode := SingleChoice;
  189.     SingleFlagLine := 3;
  190.     Title   := '~First';
  191.     Line[1] := '~A line';
  192.     Line[2] := '~B line';
  193.     Line[3] := '~C line';
  194.     Line[4] := '~D line';
  195.     Line[5] := '';              LineMode[5] := Partition;
  196.     Line[6] := 'E~xit';         ProcPtr[6]  := SetQuit;
  197.     DefaultLine := 2;
  198.     MsgLineNum  := ord(MainML);
  199.     HelpWndwNum := ord(MainMenuHW);
  200.     SaveMainMenu;
  201.  
  202.     GetMainMenu (QuitMenu);
  203.   { MenuMode := ExecChoice; }   { This is the default }
  204.     Title   := '~Quit';
  205.     Line[1] := '~Stay';
  206.     Line[2] := '~Quit';         ProcPtr[2] := SetQuit;
  207.     BackToDefault := true;
  208.     MsgLineNum  := ord(MainML);
  209.     HelpWndwNum := ord(MainMenuHW);
  210.     SaveMainMenu;
  211.  
  212.   { ----------------------- Set up your SubMenus here: --------------------- }
  213.   { Careful! -- indexes to SubMenus must be numbered in order of level; i.e.,}
  214.   { ALL SubMenus first, ALL SubSubMenus second, ALL SubSubSubMenus, ... etc. }
  215.  
  216.     {$ifdef UseSubMenuCode }
  217.  
  218.     GetSubMenu (MySubMenu);
  219.     MenuMode := SingleChoice;
  220.     SingleFlagLine := 5;
  221.     Line[1] := '~1 line';
  222.     Line[2] := '~2 line';
  223.     Line[3] := '~3 line';
  224.     Line[4] := '~4 line';
  225.     MsgLineNum  := ord(SubML);
  226.     HelpWndwNum := ord(SubMenuHW);
  227.     SaveSubMenu;
  228.  
  229.     {$endif UseSubMenuCode }
  230.  
  231.   end;  { with TopMenu }
  232.  
  233.   { ------------------ Set up your Message Lines here: ---------------------- }
  234.   { Concatenations here allow source to print on 80 col printer.              }
  235.   { All messages up to HelpML are reserved.                                   }
  236.  
  237.   {$ifdef UseMsgLineCode }
  238.   MsgLine[ord(WorkML)]:=' ~F1~-help  ~F2~-pull  ~F10~-top';
  239.   MsgLine[ord(TopML)] :=' ~F1~-help  ~F2~-pop   ~LTR~-cmd  ~ESC~-return  '+
  240.                         '        ~'^[^Z'~ hilight            ~CR~-select';
  241.   MsgLine[ord(AltML)] :=' ~Alt-F~-First                            '+
  242.                         '                             ~Alt-X~-Exit';
  243.   MsgLine[ord(MainML)]:=' ~F1~-help  ~F2~-pop   ~LTR~-cmd  ~ESC~-return  '+
  244.                         '        ~'^[^Z'~ menus  ~'^X^Y'~-hilight  ~CR~-select';
  245.   MsgLine[ord(SubML)] :=' ~F1~-help  ~F2~-pop   ~LTR~-cmd  ~ESC~-return  '+
  246.                         '                  ~'^X^Y'~-hilight  ~CR~-select';
  247.   MsgLine[ord(DW_ML)] :=' ~F1~-help  ~F2~-pop   ~F10~-top  ~ESC~-restore '+
  248.                         '                              ~CR~-enter';
  249.   MsgLine[ord(DE_ML)] :=' ~F1~-help  ~F2~-pull  ~F10~-top  ~ESC~-restore '+
  250.                         '                              ~CR~-enter';
  251.   MsgLine[ord(SeqML)] :=' ~F1~-help  ~F2~-pull  ~F10~-top              '+
  252.                         '                              ~CR~-edit';
  253.   MsgLine[ord(HelpML)]:=' ~F1~-return         ~LTR~-cmd  ~ESC~-return';
  254.   MsgLine[ord(ProcML)]:=' Processing ...';
  255.   {$endif UseMsgLineCode }
  256.  
  257.   { ------------------- Set up your Help Lines here: ------------------------ }
  258.   {$ifdef UseHelpWndwCode }
  259.  
  260.   HelpLine[ord(HLw1)]:='Work window help message';
  261.   HelpLine[ord(HLwL)]:='';
  262.  
  263.   HelpLine[ord(HLt1)]:='Move cursor and press return OR type a command';
  264.   HelpLine[ord(HLtL)]:='letter.  ESC to return to the Work window.';
  265.  
  266.   HelpLine[ord(HLm1)]:='Main menu help message';
  267.   HelpLine[ord(HLmL)]:='';
  268.  
  269.   HelpLine[ord(HLs1)]:='Submenu help message';
  270.   HelpLine[ord(HLsL)]:='';
  271.  
  272.   HelpLine[ord(HLd1)]:='This is a data entry field.  Only valid alpha-';
  273.   HelpLine[ord(HLd2)]:='numeric characters can be typed.  Full editing';
  274.   HelpLine[ord(HLd3)]:='capability:';
  275.   HelpLine[ord(HLd4)]:='  1. WordStar keys: ^A,^S,^D,^F,^G,^H,^R,^Y,^U';
  276.   HelpLine[ord(HLd5)]:='  2. Cursor keys:   Home/End, Left/Right Arrow,';
  277.   HelpLine[ord(HLd6)]:='     Ctrl-Left/Right Arrow, and Ins/Del.';
  278.   HelpLine[ord(HLdL)]:='  3. Use ^R or ^U to restore original data.';
  279.  
  280.   { ----------------------- Set up your Help Windows here: ------------------ }
  281.   { HelpWndw[ord(WorkWndwHW)] is reserved for the Work window. }
  282.   { HelpWndw[ord(TopLineHW) ] is reserved for the top line menu. }
  283.  
  284.   HelpMsgLineNum := ord(HelpML);     { Standard message for a Help window }
  285.   SetHelpLines (WorkWndwHW,HLw1,HLwL);
  286.   SetHelpLines (TopLineHW ,HLt1,HLtL);
  287.   SetHelpLines (MainMenuHW,HLm1,HLmL);
  288.   SetHelpLines (SubMenuHW ,HLs1,HLsL);
  289.   SetHelpLines (DataWndwHW,HLd1,HLdL);
  290.  
  291.   {$endif UseHelpWndwCode }
  292.  
  293. end;  { procedure GetUserPullStats }
  294.  
  295. { =========================== GetOverrideStats ============================== }
  296. { You can OVERRIDE the automatic Colors, Sizes, and Locations here.           }
  297. { --------------------------------------------------------------------------- }
  298.  
  299. procedure GetOverrideStats;
  300. begin
  301.   { No overrides included. }
  302. end;
  303.  
  304. { ========================= CHECK GLOBAL KEYS =============================== }
  305. { This procedure gives you the option to add global keys similar to TP4 such  }
  306. { as Alt-R or Alt-F3.  This is for extended keys only.                        }
  307. { --------------------------------------------------------------------------- }
  308.  
  309. const
  310.   { See the extended key code table in your manual for these values: }
  311.   AltF    = #33;    { First menu }
  312.   AltQ    = #16;    { Quit menu }
  313.   AltX    = #45;    { Immediately exit program }
  314.  
  315. procedure SetWorkWndw (WN: WindowNames);
  316. begin
  317.   PullDown        := false;
  318.   PopToWorkWndw   := true;
  319.   TopWorkWndwName := WN;
  320. end;
  321.  
  322. { -- Any of the keys can be modified.  PopKey and TopKey1 are defined in }
  323. { -- PullVars.inc. }
  324. procedure CheckGlobalKeys;
  325. begin
  326.   PullDown := true;
  327.   case Key of
  328.     PopKey:  begin PullDown:=false; PopToWorkWndw:=true; end; { F2 }
  329.     TopKey1: PopToTop:=true;                                  { F10 }
  330.     AltF:    SetCmdSeq ('F');
  331.     AltQ:    SetCmdSeq ('Q');
  332.     AltX:    SetQuit;
  333.   else
  334.     PullDown := false;
  335.   end
  336. end;
  337.  
  338. BEGIN
  339.   CallGetUserPullStats := GetUserPullStats;
  340.   CallGetOverrideStats := GetOverrideStats;
  341.   CallCheckGlobalKeys  := CheckGlobalKeys;
  342. END.
  343.